home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / basic / neatlist.bas < prev    next >
BASIC Source File  |  1985-12-10  |  12KB  |  184 lines
  1. 64321 GOTO 64421:REM Branch to start of program.  Subrountines are generally up front.
  2. 64322 REM This is the Neatlist program for PC -AT using BASICA or BASIC
  3. 64323 I=FNI(I):B=PEEK(I):RETURN:REM Looks at next byte
  4. 64324 GOSUB 64323:D=B:GOSUB 64323:D=256*B+D:RETURN:REM This statement gets two byte integer values
  5. 64325 D#=0:FOR Z=1 TO 6:GOSUB 64331:NEXT Z:GOSUB 64323:D#=((D#/256)+B)/128+1:GOSUB 64323:G$=G$+STR$(D#*2#^(B-129)):RETURN:REM This statement gets 8-byte value of a Real number
  6. 64326 GOSUB 64336:GOSUB 64336:GOSUB 64337:RETURN
  7. 64327 D#=0:GOSUB 64331:GOSUB 64331:GOSUB 64323:D=((D#/256)+B)/128+1:GOSUB 64323:G$=G$+STR$(D*(2^(B-129))):RETURN :REM This statement gets 4-byte value of Real number
  8. 64328 GOSUB 64323:B=B-128:G$=G$+F1$(B):RETURN:REM get function tokens
  9. 64329 GOSUB 64323:B=B-128:G$=G$+F3$(B):RETURN
  10. 64330 GOSUB 64323:B=B-128:G$=G$+F2$(B):RETURN
  11. 64331 GOSUB 64323:D#=((D#/256)+B):RETURN:REM Real number repeated operation
  12. 64332 G$=G$+STR$(B):RETURN:REM Puts values into collection string
  13. 64333 G$=G$+STR$(D):RETURN
  14. 64334 G$=G$+T$(B):RETURN
  15. 64335 IA$=INKEY$:IF IA$="" GOTO 64335 ELSE IA=ASC(IA$):IF IA>96 AND IA<123 THEN IA$=CHR$(IA-32):RETURN ELSE RETURN:REM Standard input routine for 1 character.  Character is always upper case.
  16. 64336 D=0:GOSUB 64337:PRINT:IF FL=1 THEN LPRINT:RETURN ELSE RETURN:REM This routine prints a new line and checks for new page requirement
  17. 64337 LC=LC+1:WHILE LC>LP :REM New page procedure
  18. 64338 LC=6:PC=PC+1:PRINT :PRINT BB$;LB$;"<Continued>"
  19. 64339 IF FL=1 THEN LPRINT :LPRINT BB$;LB$;"<Continued>"
  20. 64340 FOR K=LP TO 63:PRINT :IF FL=1 THEN LPRINT
  21. 64341 NEXT
  22. 64342 H$(4)="Page "+STR$(PC):REM Generates new heading
  23. 64343 FOR K=1 TO 4:E=INT((LL-LEN(H$(K)))/2)+1:PRINT M$;LEFT$(BB$,E);H$(K):IF FL=1 THEN LPRINT M$;LEFT$(BB$,E);H$(K)
  24. 64344 NEXT K:IF FL=1 THEN LPRINT
  25. 64345 PRINT :IF D THEN 64346 ELSE RETURN
  26. 64346 K=LEN(N$):IF LEFT$(N$,1)=S$ THEN N$=RIGHT$(N$,K-1):GOTO 64346
  27. 64347 K=LEN(N$):IF RIGHT$(N$,1)=S$THEN N$=LEFT$(N$,K-1):GOTO 64347
  28. 64348 C$=RIGHT$((LEFT$(LB$,(8-K))+CHR$(123)+N$+CHR$(125)+S$),9)+RIGHT$(C$,(LEN(C$)-9)):WEND :RETURN
  29. 64349 GOSUB 64324:IF D>0 GOTO 64357:REM Checks for zero address which ends program
  30. 64350 GOSUB 64326:PRINT M$;LB$;"End of listing"
  31. 64351 IF FL=1 THEN LPRINT M$;LB$;"End of listing" :REM End of program
  32. 64352 GOSUB 64326:PRINT M$;"Program has ";TN-1;" ";
  33. 64353 PRINT"total BASIC lines,":PRINT TR;" remarks and ";TS;" total statements."
  34. 64354 IF FL=1 THEN LPRINT M$;"Program has ";TN -1;" total BASIC lines,":LPRINT TR;" remarks and "; TS;" total statements."
  35. 64355 GOSUB 64326:PRINT M$;"END!":IF FL=1 THEN LPRINT M$;"End!";CHR$(12)
  36. 64356 STOP
  37. 64357 TN=TN+1:GOSUB 64324:EL=0:K=D:CS=0:REM Line number counter
  38. 64358 IF K>KN OR K>65431! THEN 64350 ELSE D=LEN(STR$(K)):N$=RIGHT$((LEFT$(LB$,(9-D))+STR$(K)+"   "),10):REM check of line #
  39. 64359 TS=TS+1:D=0:GOSUB 64323:REM Increment total statements
  40. 64360 IF B=58 THEN B=143:IF PEEK(FNI(I))=143 AND PEEK(FNI(FNI(I)))=219 THEN I=FNI(FNI(I))
  41. 64361 IF B=143 AND NOT RF THEN GOTO 64364:REM If we just set it and didn't set the REM flag, continue
  42. 64362 IF B=143 AND RF THEN 64364:REM Separate groups of remarks
  43. 64363 IF RF THEN RF=0:GOSUB 64336
  44. 64364 IF B=0 THEN 64396:REM Force End of line
  45. 64365 IF B = 186 THEN OF = 1:REM OPEN Flag
  46. 64366 IF B= 32 AND RF<>1 AND QF = -1 THEN GOSUB 64323:GOTO 64364
  47. 64367 IF B>127 THEN B=B-128:GOTO 64380:REM Token? then subtract and find token
  48. 64368 IF B>31 THEN 64377
  49. 64369 IF B>16 AND B<27 THEN B=B-17:GOSUB 64332:GOSUB 64323:GOTO 64364:REM SMALL INTEGER. 0-9
  50. 64370 IF B=13 THEN DD=D:GOSUB 64324:Z=I:I=D+2:GOSUB 64324:GOSUB 64333:I=Z:GOSUB 64323:D=DD:GOTO 64364:REM GOTO number computation. two byte
  51. 64371 IF B=14 OR B=28 THEN DD=D:GOSUB 64324:GOSUB 64333:GOSUB 64323:D=DD:GOTO 64364:REM TWO BYTE INTEGER
  52. 64372 IF B=12 THEN DD=D:GOSUB 64324:G$=G$+"&H "+HEX$(D)+" ":GOSUB 64323:D=DD:GOTO 64364
  53. 64373 IF B=11 THEN DD=D:GOSUB 64324:G$=G$+"&O "+OCT$(D)+" ":GOSUB 64323:D=DD:GOTO 64364
  54. 64374 IF B=15 THEN GOSUB 64323:GOSUB 64332:GOSUB 64323:GOTO 64364:REM INTEGER UP TO 255
  55. 64375 IF B=29 THEN DD=D:GOSUB 64327:D=DD:GOSUB 64323:GOTO 64364:REM FOUR BYTE FLOATING
  56. 64376 IF B=31 THEN DD=D:GOSUB 64325:D=DD:GOSUB 64323:GOTO 64364:REM EIGHT BYTE FLOATING
  57. 64377 IF B=34 THEN QF=-QF:REM check for quoted strings
  58. 64378 IF B=58 AND NOT RF AND QF <1 THEN TS=TS+1:GOTO 64396:REM check for colon
  59. 64379 G$=G$+CHR$(B):GOSUB 64323:GOTO 64364:REM Collect the character if not already taken care of
  60. 64380 IF B=127 THEN GOSUB 64328:GOSUB 64323:GOTO 64364:REM Get Function token into string
  61. 64381 IF B=125 THEN GOSUB 64329:GOSUB 64323:GOTO 64364
  62. 64382 IF B=126 THEN GOSUB 64330:GOSUB 64323:GOTO 64364
  63. 64383 IF B=15 THEN TR=TR+1:RF=1:RS=1:REM REM recognition
  64. 64384 IF B=2 THEN FF=1:REM FOR loop
  65. 64385 IF B =2 AND OF = 1 THEN FS=FNJ(FS):OF=0:FF =0
  66. 64386 IF B=33 THEN GOSUB 64334:CS=FNJ(CS):EL=1:GOTO 64396: REM ELSE statement
  67. 64387 IF B=77 THEN CF=1:GOSUB 64334:GOTO 64396:REM THEN Token
  68. 64388 IF B=49 AND PEEK(FNI(I))=233 THEN WF=1:GOSUB 64334:I=FNI(I):GOSUB 64323:GOTO 64364:REM Check for WHILE
  69. 64389 IF B=50 THEN WS =FNJ(WS):GOSUB 64334:GOSUB 64323:GOTO 64364
  70. 64390 IF B=4 THEN DF=1
  71. 64391 IF B=3 THEN FS=FNJ(FS):REM NEXT
  72. 64392 IF B=3 AND EL>0 THEN CS=FNJ(CS)
  73. 64393 GOSUB 64334:GOSUB 64323:GOTO 64364
  74. 64394 SF=0:RS=RS+1:IF RS>2 THEN RS=2
  75. 64395 IF DF AND RS>1 THEN RS=1:REM Add extra indent after split line
  76. 64396 K=IM*(FS+CS+RS+WS):E=K+13:IF K>0 THEN G$=LEFT$(BB$,K)+G$:REM Compute indentation and get low-limit for split point
  77. 64397 IF WF THEN WS=WS+1:WF=0:REM Add to indent after a WHILE
  78. 64398 IF EL=1 THEN CS=CS+1:REM After ELSE indent following statement(s)
  79. 64399 IF FF=1 THEN FS=FS+1:FF=0:REM Indent additional after a FOR and reset flag
  80. 64400 IF D THEN C$=LB$+G$ ELSE C$=N$+G$:REM Add line number string or equivalent blank
  81. 64401 K=LEN(C$)-LL:IF K<1 THEN 64412:REM Not a split line
  82. 64402 G$=RIGHT$(C$,K):C$=LEFT$(C$,LL):SF=1:IF DF THEN 64406:REM Start split with a space if not "data"
  83. 64403 D=LL
  84. 64404 IF MID$(C$,D,1)=S$ THEN 64411
  85. 64405 D=D-1:IF D>E THEN 64404
  86. 64406 D=LL:REM Split next at arithmetic op or comma
  87. 64407 K=ASC(MID$(C$,D,1)):IF K<42 OR K>47 THEN 64410
  88. 64408 IF DF AND K=44 THEN 64411:REM DATA Split only on comma
  89. 64409 IF NOT DF AND K<>46 THEN 64411:REM Other statements split by all but period
  90. 64410 D=D-1:IF D>E THEN 64407 ELSE 64412:REM Fall-through = end of line split
  91. 64411 K =LL-D:IF K>0 THEN G$=RIGHT$(C$,K)+G$:C$=LEFT$(C$,D):REM Test page line count then print at line 65172
  92. 64412 GOSUB 64337:K=LEN(C$): IF SF=0 OR K<2 OR RF THEN 64415
  93. 64413 IF MID$(C$,K)=S$ THEN C$=LEFT$(C$,(K-1))+CHR$(95):REM Put trailing underline in place of last space
  94. 64414 IF LEN(G$)>2 AND LEFT$(G$,1)=S$ THEN G$=CHR$(95)+RIGHT$(G$,LEN(G$)-1):GOTO 64414:REM put leading underline inplace of leading space
  95. 64415 IF FL=1 THEN LPRINT M$;C$
  96. 64416 PRINT M$;C$:C$="":IF SF THEN D=1:GOTO 64394
  97. 64417 QF=-1:RS=0:DF=0:EL=0:OF=0:IF FF THEN FS=FS+1:FF=0
  98. 64418 D=0:IF CF THEN CS=CS+1:CF=0
  99. 64419 SF=0:G$="":IF B=0 THEN CS=0:GOTO 64349:REM Get another print line in case Not End of Line else fall thru and get new line number
  100. 64420 GOSUB 64323:D=1:GOTO 64364
  101. 64421 CLEAR 2500:DIM T$(127),H$(4),F1$(38),F2$(36),F3$(8):DEF FNI(I)=I+1:DEF FNJ(I)=(I<0)*0-(I>0)*(I-1):I=25533:B=0:K=0:L=0:WS=0:RS =0:CS=0:FS=0:EL=0:RF=0:CF=0:FF=0:DF=0:SF=0:QF=-1:LL=70:LP=63:IM=4:E=0:TN=0:TS=0:TR=0:S$=" ":N$="":G$=""
  102. 64422 IF PEEK(3704)=0 THEN I=3704 ELSE I= 4137
  103. 64423 M$="":H$(0)="":LB$="          ":BB$="                                           ":FL = 0:C$="":DATA "NEATLIST"
  104. 64424 DATA "END ","FOR ","NEXT ","DATA ","INPUT ","DIM ","READ ","LET "
  105. 64425 DATA "  GOTO ","RUN ","IF ","RESTORE ","  GOSUB ","RETURN "
  106. 64426 DATA "  *  ":REM THIS IS FOR REMARK
  107. 64427 DATA "STOP ","PRINT ","CLEAR ","LIST ","NEW "," ON ","WAIT "
  108. 64428 DATA "DEF ","POKE ","CONT ",154,155,"OUT ","LPRINT ","LLIST",159
  109. 64429 DATA "WIDTH ","ELSE ","TRON ","TROFF","SWAP ","ERASE ","EDIT ","ERROR "
  110. 64430 DATA "RESUME ","DELETE ","AUTO ","RENUM ","DEFSTR ","DEFINT ","DEFSNG "
  111. 64431 DATA "DEFDBL ","LINE ","WHILE ","WEND ","CALL ",180,181,182,"WRITE "
  112. 64432 DATA "OPTION ","RANDOMIZE ","OPEN ","CLOSE ","LOAD ","MERGE ","SAVE "
  113. 64433 DATA "COLOR ","CLS ","MOTOR ","BSAVE ","BLOAD","SOUND ","BEEP ","PSET"
  114. 64434 DATA "PRESET ","SCREEN ","KEY ","LOCATE ",203," TO "," THEN ","TAB("
  115. 64435 DATA "STEP ","USR ","FN ","SPC"," NOT ","ERL ","ERR ","STRING$"
  116. 64436 DATA "USING ","INSTR","'","VAPTR ","CSRLIN ","POINT ","OFF","INKEY$ "
  117. 64437 DATA 223,224,225,226,227,228,229," > "," = ", " < "," + "," - "," * "," / ","^"," AND "," OR "
  118. 64438 DATA " XOR ","EQV","IMP","MOD"," \ "
  119. 64439 REM Begin  255 prefix
  120. 64440 DATA "LEFT$","RIGHT$","MID$","SGN","INT",ABS,SQR,RND,SIN,LOG,EXP,COS,TAN
  121. 64441 DATA ATN,FRE,INP,POS,LEN,STR$,VAL,ASC,CHR$,PEEK,SPACE$,OCT$,HEX$,LPOS,CINT
  122. 64442 DATA CSNG,SDBL,FIX,PEN,STICK,STRIG,EOF,LOC,LOF
  123. 64443 REM Begin 254 prefix
  124. 64444 DATA FILES,FIELD,SYSTEM,NAME,LSET,RSET,KILL,PUT,GET,RESET,COMMON,CHAIN
  125. 64445 DATA DATE$,TIME$,PAINT,COM,CIRCLE,DRAW,PLAY,TIMER,ERDEV,IOCTL,CHDIR,MKDIR
  126. 64446 DATA RMDIR,SHELL,ENVIRON,VIEW,WINDOW,PMAP
  127. 64447 REM Begin 253 prefix
  128. 64448 DATA CVI,CVS,CVD,MKI$,MKS$,MKD$
  129. 64449 WHILE R$<>"NEATLIST":READ R$:WEND
  130. 64450 FOR T=1 TO 116:READ T$(T):NEXT :FOR T=1 TO 37: READ F1$(T):NEXT T
  131. 64451 FOR T =1 TO 30:READ F2$(T):NEXT T
  132. 64452 FOR T =1 TO 6:READ F3$(T):NEXT T
  133. 64453 DATA test2,test3,4,5
  134. 64454 PRINT:INPUT"Program name: ";H$(1):INPUT"  Programmer: ";H$(2):INPUT"        Date: ";H$(3)
  135. 64455 PRINT"Page length is "LP" lines, want other?":GOSUB 64335:IF IA$="Y" THEN INPUT"Page length ";LP
  136. 64456 INPUT"Enter the largest line number you wish to print";KN:IF KN=0 THEN KN=64320! ELSE PRINT"Is this ";KN;" the number you wish?":GOSUB 64335:IF IA$<>"Y" AND IA$<>" " THEN 64456
  137. 64457 PRINT"If you want to print hit 'P' else hit any key to display on the screen":GOSUB 64335
  138. 64458 IF IA$<>"P" THEN 64459 ELSE FL=1
  139. 64459 LC=6:PC=1:GOSUB 64342:GOTO 64349
  140. 64460 REM  Begin Table of Variable Use
  141. 64461 REM     B       Program byte decimal value
  142. 64462 REM     BB$     Big set of blanks (48)
  143. 64463 REM     CF      IF flag.  If started CF = 1
  144. 64464 REM     CS      IF indent space counter
  145. 64465 REM     C$      Collection String
  146. 64466 REM     D       Direction temporary variable
  147. 64467 REM     D#      Collection term for floating point numbers
  148. 64468 REM     DF      Data Flag = 1 when DATA on a line
  149. 64469 REM     E       Temporary for split-line limits
  150. 64470 REM     EL      ELSE flag
  151. 64471 REM     F$()    Function Token Array
  152. 64472 REM     FF      FOR Flag = 1 when FOR is encountered
  153. 64473 REM     FL      Flag =1 if display is printed
  154. 64474 REM     FS      FOR spacing counter
  155. 64475 REM     G$      Gathering String
  156. 64476 REM     H$()    Page title header array
  157. 64477 REM     I       Pointer to program byte in RAM
  158. 64478 REM     IA      Input response 
  159. 64479 REM     IA$     Input Answer string
  160. 64480 REM     IM      Indent Multiplier
  161. 64481 REM     K       Temporary
  162. 64482 REM     LB$     Little Blank (10)
  163. 64483 REM     LC      Line Counter for pagination
  164. 64484 REM     LL      Line Length (width)
  165. 64485 REM     LP      Lines Per Page Constant
  166. 64486 REM     M$      Left margin spacing string
  167. 64487 REM     N$      Line Number string
  168. 64488 REM     OF      OUTPUT Flag (used to prevent open statements from erroneously indenting
  169. 64489 REM     PC      Page Counter for header
  170. 64490 REM     QF      Quote Flag = 1 if Quote found, -1 if not Quote
  171. 64491 REM     RF      REMark Flag
  172. 64492 REM     RS      REMark indent spacing
  173. 64493 REM     SF      Split Line Flag
  174. 64494 REM     S$      Single Space
  175. 64495 REM     T$()    Token Array
  176. 64496 REM     TN      Line Number counter
  177. 64497 REM     TS      Total Statement Counter
  178. 64498 REM     WF      WHILE Flag
  179. 64499 REM     WS      WHILE indent spacing
  180. 64500 REM     Z       Temporary
  181. 64501 REM     FNI     Increment by 1 up to 32767 when becomes -32768
  182. 64502 REM     FNJ     Decrement and not less than zero
  183. 64503 REM  End of Program
  184.